home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
SHELLS
/
SZ2
/
INPUT2.INC
< prev
next >
Wrap
Text File
|
1992-08-31
|
6KB
|
189 lines
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
DATA
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
CONST
MaxRecs = 5 ;
FldCnt = 4 ;
CurRec : longint = 1 ;
TYPE
TDataRecord = array [ 1..FldCnt ] of
string ;
TDataArray = array [ 1..MaxRecs ] of
TDataRecord ;
VAR
DataArray : TDataArray ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
DATA TRANSFER - note that we do NOT have to pay attention to the
dialog's record structure; "Get/Set DataRec" (from the GENERAL
unit) will access only sub-views which accept or return data.
This lets us use plain, vanilla "string" type, so we can use the
dialog's TInputLine to change the acceptable length of the field.
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
DIALOG --> BUFFER (read each TInputLine field)
===================================================================}
procedure GetAllFields ( D : PDialog ) ;
var
x : byte ;
begin
for x := 1 to FldCnt do
GetDataRec ( D ,
x ,
@DataArray[CurRec][x] ) ;
end ;
{===================================================================
BUFFER --> DIALOG (writes each TInputLine field)
===================================================================}
procedure SetAllFields ( D : PDialog ) ;
var
x : byte ;
begin
for x := 1 to FldCnt do
SetDataRec ( D ,
x ,
@DataArray[CurRec][x] ) ;
SetDataRec ( D , FldCnt + 1 , @CurRec ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
FORM
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
TYPE
PForm = ^TForm ;
TForm = OBJECT ( TDialog )
EditMode : boolean ;
function GetHelpCtx : word ; virtual ;
procedure HandleEvent ( VAR Event : TEvent ) ; virtual ;
END ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
CONTEXT - Enable hints if in "EditMode"; disable otherwise.
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function TForm.GetHelpCtx : word ;
var
W : word ;
begin
W := TDialog.GetHelpCtx ;
if not EditMode then
if W >= 1000 then
W := hcNoContext ;
GetHelpCtx := W
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
EVENT
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
procedure TForm.HandleEvent ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure hdPrevRecord ;
begin
if CurRec = 1 then
begin
buzz ;
EXIT ;
end ;
GetAllFields ( @SELF ) ;
dec ( CurRec ) ;
SetAllFields ( @SELF ) ;
end ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure hdNextRecord ;
begin
if CurRec = MaxRecs then
begin
buzz ;
EXIT ;
end ;
GetAllFields ( @SELF ) ;
inc ( CurRec ) ;
SetAllFields ( @SELF ) ;
end ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure hdFirst ;
begin
GetAllFields ( @SELF ) ;
CurRec := 1 ;
SetAllFields ( @SELF ) ;
end ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure hdLast ;
begin
GetAllFields ( @SELF ) ;
CurRec := MaxRecs ;
SetAllFields ( @SELF ) ;
end ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure hdEdit ;
begin
EditMode := not EditMode ;
if EditMode then
begin
SetStaticText ( @SELF , TRUE ) ;
SetBorder ( CRT.LightRed ) ;
end
else
begin
SetStaticText ( @SELF , FALSE ) ;
SetBorder ( CRT.LightGray ) ;
end ;
end ;
{===================================================================
COMMAND
===================================================================}
procedure HandleCommand ;
begin
case Event.Command of
cmFirst : hdFirst ;
cmLast : hdLast ;
cmNextRecord : hdNextRecord ;
cmPrevRecord : hdPrevRecord ;
cmEdit : hdEdit ;
else
EXIT ;
end ;
ClearEvent ( Event ) ;
end ;
{===================================================================
KEYDOWN
===================================================================}
procedure HandleKeyDown ;
begin
if not EditMode then
begin
ClearEvent ( Event ) ;
Buzz ;
EXIT ;
end ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
case Event.What of
evCommand : HandleCommand ;
evKeyDown : HandleKeyDown ;
end ;
TDialog.HandleEvent ( Event ) ;
end ;